Mac Mania 2/MacMania 2.toast/Demo's/Tools&Utilities/Programming/MacStarter Pascal 1.0/xWindows definition files/xInputDecoration.p

Text File | 1993-02-16 | 15.5 KB | 570 lines | [TEXT/PJMM]

unit xInputDecoration;

{ The "decorations" defined in this unit are boxes into which the user can type }
{ strings.  You can then retrieve the strings typed.  Subclasses of the basic }
{ xStringInput restrict the type of input allowed (for example, to integers in }
{ a specified range).  Procedures are provided for you to retrieve the values }
{ entered. }
{    If you have several of these decorations in a window, then pressing the tab}
{ key will move from one to another (just as it would in a dialog box). }
{     You should not use an xStringInput in an xTetWindow unless you have locked the }
{ text in that window.  (Otherwise, the system won't know what to do with key }
{ presses.) }

interface

uses
    xWindow;

type
    xStringInput = object(xWindowDecoration)
            { a box in which the user can type a string, that you can later retrieve }
            TE: TEHandle;  { holds the text }
            maxLength: integer;  { maximum allowed length of string; set to 255 by default }
            procedure SetUp (win: xWindow;
                                        theLeft, theTop, theWidth, theHeight: integer);
           { Installs the xStringInput in the given window at the specified location. }
           { The meanings of theLeft, theTop, theWidth and theHeight are not }
           { straightforward when the numbers are not positive; see the discussion in }
           { the comments on procedure xWindowDecoration.Install in unit xWindow.p }
           { Note: theHeight will generally be of the form 16*n+8, where n is the }
           {          number of lines of text you want to allow.  (This assumes the }
           {          standard application font. ) }
            procedure SetContents (str: string);
           { Put the specified string into the box; use this to provide a default value, }
           { for example. }
            procedure GetContents (var str: string);
           { Get the string currently in the box. }
            procedure Hilite (rangeStart, rangeEnd: integer);
           { Hilite a range of characters in the string.  Use Hilite(0,255) to hilite the }
           { entire string; use Hiilite(n,n) to set the insertion point to a position after }
           { the n-th character }
            procedure SetMaxLength (max: integer);
           { Set the maximum allowed length for the string entered by the user.  If the }
           { attempts to type more characters, the computer will beep. }
            procedure doTab;
           { move to next xStringInput in the window, hiliting its contents; called }
           { automatically when user presses the tab key. }
            procedure doKey (ch: char;
                                        modifiers: longint);  { process a key press }
            override;
            procedure doClick (localPt: point;  { process a mouse click }
                                        modifiers: longint);
            override;
            procedure doDraw;  { redraw the box when necessary }
            override;
            procedure kill;   { remove the box and delete its storage }
            override;
            procedure adjustSize;  { react to change in size of window }
            override;
            procedure doActivate (active: boolean);  { react to window activation/deactivation }
            override;
            procedure idle;   { the idle for a string box involves blinking the cursor }
            override;
            procedure hide;   { hide the box }
            override;
            procedure show;  { show the box again }
            override;
            procedure select;
           { deselects any currently active xStringInput, and selects this one }
        end;

    xIntegerInput = object(xStringInput)
           { an xStringInput in which the user must type an integer. Characters that }
           { cannot occur in an integer will be rejected, and the computer will beep }
            maxVal, minVal: longint;  { the minimum and maximum values that will be }
                { accepted; the ERR parameter in GetNumber will be set to true }
                { if the number lies outside  this range. }
            displayAlertOnError: boolean;  { if this is set to true (the default value), the }
                { user will be alerted by an alert box if the contents of the input box }
                { do not represent a legal integer in the specified range when you }
                { call get number; if it is false, the ERR parameter will be set, but the  }
                { user will not be informed of the error. }
            procedure SetLegalRange (min, max: longint);
                { Change the maximum and minimum values that you will accept; by default,}
                { these are MaxLongint and -MaxLongint, giving no restriction at all. }
            procedure GetNumber (var n: longint;
                                        var err: boolean);
                { Retrieved the number entered by the user.  If it is not a legal number in }
                { the specified range, n will be undefined and ERR will be set to TRUE. }
                { Note that you can still call the procedure GetContents to get the STRING }
                { entered by the user. }
            procedure SetContentsToNumber (n: longint);
                { Enter a number into the box. }
            procedure SetUp (win: xWindow;
                                        theLeft, theTop, theWidth, theHeight: integer);
            override;
           { same function as overridden procedure }
            procedure doKey (ch: char;
                                        modifiers: longint);
            override;
          { modifies doKey to reject illegal characters. }
        end;


    xRealInput = object(xStringInput)
         { Same description as xIntegerInput, except that real numbers are used. }
         { Exponential form is allowed, as long as there are three digits or fewer in }
         { the exponent. }
            maxVal, minVal: extended;
            displayAlertOnError: boolean;
            procedure SetLegalRange (min, max: extended);
            procedure GetNumber (var n: extended;
                                        var err: boolean);
            procedure SetContentsToNumber (n: extended);
            procedure SetUp (win: xWindow;
                                        theLeft, theTop, theWidth, theHeight: integer);
            override;
            procedure doKey (ch: char;
                                        modifiers: longint);
            override;
        end;


implementation


procedure xStringInput.select;
{ deselects any currently active xStringInput, and selects s }
    var
        d: xWindowDecoration;
        xWin: xWindow;
    begin
        xWin := itsWindow;
        if (xWin = nil) then
            EXIT(select);
        d := xWin.decorations;
        while d <> nil do begin
                if member(d, xStringInput) & d.wantsKey then begin
                        d.wantsKey := false;
                        d.doActivate(false);
                    end;
                d := d.nextDecoration;
            end;
        wantsKey := true;
        doActivate(true);
        TESetSelect(0, 32000, TE);
    end;


procedure xStringInput.SetUp (win: xWindow;
                                theLeft, theTop, theWidth, theHeight: integer);
    var
        savePort: GrafPtr;
        R: Rect;
        ch: cursHandle;
    begin
        if win.theWindow = nil then
            EXIT(setup);
        init;
        GetPort(savePort);
        SetPort(win.theWindow);
        SetRect(R, 0, 0, 10, 10);
        TE := TENew(R, R); { junk }
        TEAutoView(true, TE);
        SetPort(savePort);
        Install(win, theLeft, theTop, theWidth, theHeight);
        adjustSize;
        maxLength := 255;
        wantsClick := true;
        ch := getCursor(iBeamCursor);
        if ch <> nil then begin
                useCursor(ch^^);
            end;
        select
    end;

procedure xStringInput.SetContents (str: string);
    var
        R: rect;
        savePort: GrafPtr;
        win: WindowPtr;
    begin
        if str = '' then
            TESetText(@str, 0, TE)
        else
            TESetText(@str[1], length(str), TE);
        R := TE^^.viewRect;
        GetPort(savePort);
        win := itsWindow.theWindow;
        SetPort(win);
        EraseRect(R);
        TEUpdate(R, TE);
        SetPort(savePort);
    end;

procedure xStringInput.GetContents (var str: string);
    var
        s: str255;
    begin
        GetIText(TE^^.hText, s);
        str := s
    end;

procedure xStringInput.Hilite (rangeStart, rangeEnd: integer);
    begin
        if not wantsKey then
            select;
        TESetSelect(rangeStart, rangeEnd, TE);
    end;

procedure xStringInput.SetMaxLength (max: integer);
    begin
        maxLength := max;
        if max < 1 then
            maxLength := 1
        else if maxLength > 255 then
            maxLength := 255;
    end;

procedure xStringInput.doTab;
    var
        win: xWindow;
        d: xWindowDecoration;
        startOver: boolean;
    begin
        if (itsWindow <> nil) & (itsWindow.decorations <> nil) then begin
                win := itsWindow;
                d := self;
                startOver := false;
                repeat
                    d := d.nextDecoration;
                    if d = nil then begin
                            if startover then
                                EXIT(doTab) { impossible error : self not found }
                            else begin
                                    startOver := true;
                                    d := win.decorations;
                                end;
                        end;
                until (d = self) | (member(d, xStringInput) & d.visible);
                if d <> nil then
                    xStringInput(d).select;
            end;
    end;

procedure xStringInput.doKey (ch: char;
                                modifiers: longint);
    begin
        if not wantsKey then
            EXIT(doKey);
        if ch = chr(9) then
            doTab
        else if (ch in [chr(8), chr($1C)..chr($1F)]) | (TE^^.teLength < maxLength) | (TE^^.selEnd > TE^^.selStart) then
            TEKey(ch, TE)
        else
            Sysbeep(5);
    end;

procedure xStringInput.doClick (localPt: point;
                                modifiers: longint);
    var
        win: xWindow;
        shifted: boolean;
    begin
        if not wantsKey then
            select;
        if wantsKey & PtInRect(localPt, TE^^.viewRect) then begin
                shifted := BitAnd(modifiers, shiftKey) <> 0;
                TEClick(localPt, shifted, TE);
            end
    end;

procedure xStringInput.doDraw;
    var
        R: Rect;
    begin
        R := TE^^.viewRect;
        TEUpdate(R, TE);
        InsetRect(R, -4, -4);
        FrameRect(R);
    end;

procedure xStringInput.kill;
    begin
        TEDispose(TE);
        inherited kill
    end;

procedure xStringInput.adjustSize;
    var
        savePort: GrafPtr;
    begin
        inherited adjustSize;
        if drawRect.bottom - drawRect.top < TE^^.lineHeight + 8 then
            drawRect.bottom := drawRect.top + TE^^.lineHeight + 8;
        if drawRect.right - drawRect.left < 30 then
            drawRect.right := drawRect.left + 30;
        clickRect := drawRect;
        InsetRect(clickRect, 4, 4);
        TE^^.viewRect := clickRect;
        TE^^.destRect := clickRect;
        TECalText(TE);
        if (itsWindow <> nil) & (itsWindow.theWindow <> nil) then begin
                GetPort(savePort);
                SetPort(itsWindow.theWindow);
                InvalRect(drawRect);
                SetPort(savePort);
            end;
    end;

procedure xStringInput.doActivate (active: boolean);
    begin
        if active and wantsKey then
            TEActivate(TE)
        else
            TEDeactivate(TE);
    end;

procedure xStringInput.idle;
    begin
        if wantsKey then
            TEIdle(TE);
    end;

procedure xStringInput.hide;
    begin
        if wantsKey & (itsWindow <> nil) then begin
                doTab;
                if wantsKey then begin
                        wantsKey := false;
                        doActivate(false);
                    end;
            end;
        inherited hide;
    end;

procedure xStringInput.show;
    var
        d: xWindowDecoration;
        activeTE: boolean;
    begin
        if itsWindow <> nil then begin
                d := itsWindow.decorations;
                activeTE := false;
                while d <> nil do begin
                        if member(d, xStringInput) & d.wantsKey then begin
                                activeTE := true;
                                leave
                            end;
                        d := d.nextDecoration;
                    end
            end
        else
            activeTE := true;
        inherited show;
        if not activeTE then begin
                wantsKey := true;
                if (itsWindow <> nil) & (itsWindow.theWindow <> nil) & (itsWindow.theWindow = FrontWindow) then
                    doActivate(true);
            end;
    end;

{$PUSH}
{$R-}

procedure RealToString (x: extended;
                                var s: string);
    var
        n, i: integer;
    begin
        if abs(x) < 1e-2000 then
            s := '0'
        else if (abs(x) >= 5e8) or (abs(x) < 5e-8) then begin  { exponential form }
                n := 15;
                repeat  { this is needed since the stupid computer allows 4 spaces for the exponent even if it is one two or three digits }
                    s := StringOf(x : n);
                    n := n - 1;
                    i := length(s);
                    while (i > 0) & (s[i] = ' ') do
                        i := i - 1;
                    s[0] := chr(i);
                until (length(s) <= 12) | (n = 11)
            end
        else begin
                s := StringOf(x : 1 : 10);
                i := length(s);
                while (i > 1) & (s[i] = '0') do   { strip off trailing zeros }
                    i := i - 1;
                if (i > 0) & (s[i] = '.') then  { strip off terminating decimal point }
                    i := i - 1;
                if i > 12 then  { maximum length allowed for output is 12}
                    s[0] := chr(12)
                else
                    s[0] := chr(i);
            end
    end;

{$POP}



procedure GetNum (var str: string;
                                var x: extended;
                                var err: boolean);
    var
        i, ct, len: integer;
    begin
        i := 1;
        len := length(str);
        while (i <= len) & (str[i] = ' ') do
            i := i + 1;
        if (i < len) & ((str[i] = '-') or (str[i] = '+')) then
            i := i + 1;
        while (i <= len) & (str[i] in ['0'..'9']) do
            i := i + 1;
        if (i <= len) & (str[i] = '.') then begin
                i := i + 1;
                while (i <= len) & (str[i] in ['0'..'9']) do
                    i := i + 1;
            end;
        ct := 0;
        if (i < len) & ((str[i] = 'e') | (str[i] = 'E')) then begin
                i := i + 1;
                if (i < len) & ((str[i] = '-') | (str[i] = '+')) then
                    i := i + 1;
                while (i <= len) & (str[i] in ['0'..'9']) do begin
                        i := i + 1;
                        ct := ct + 1
                    end;
            end;
        err := not ((i > len) & (ct <= 3));
        if not err then begin
                IOCheck(false);
                ReadString(str, x);
                IOCheck(True);
                if IOResult <> noErr then
                    err := true;
            end;
    end;

procedure xIntegerInput.SetLegalRange (min, max: longint);
    begin
        if max > min then begin
                minVal := min;
                maxVal := max;
            end;
    end;

procedure xIntegerInput.GetNumber (var n: longint;
                                var err: boolean);
    var
        str: string;
        x: extended;
    begin
        GetContents(str);
        GetNum(str, x, err);
        if not err then begin
                if (x < minVal) | (x > maxVal) then
                    err := true
                else
                    n := round(x);
            end;
        if err & displayAlertOnError then begin
                str := StringOf('You must type in a legal integer in the range between ', minVal : 1, ' and ', maxVal : 1, '.');
                TellUser(str);
                select;
                TESetSelect(0, 32000, TE);
            end;
    end;

procedure xIntegerInput.SetContentsToNumber (n: longint);
    begin
        SetContents(StringOf(n : 1));
    end;

procedure xIntegerInput.SetUp (win: xWindow;
                                theLeft, theTop, theWidth, theHeight: integer);
    begin
        inherited setUp(win, theLeft, theTop, theWidth, theHeight);
        TEAutoView(false, TE);
        TE^^.crOnly := -1;  { no auto word wrap }
        minVal := -maxLongInt;
        maxVal := maxLongint;
        displayAlertOnError := true;
        SetMaxLength(25);
    end;

procedure xIntegerInput.doKey (ch: char;
                                modifiers: longint);
    begin
        if not wantsKey then
            EXIT(doKey);
        if ch in ['0'..'9', '+', '-', chr(8), chr(9), chr($1C)..chr($1F)] then
            inherited doKey(ch, modifiers)
        else
            Sysbeep(5);
    end;

procedure xRealInput.SetLegalRange (min, max: extended);
    begin
        if max > min then begin
                minVal := min;
                maxVal := max;
            end;
    end;

procedure xRealInput.GetNumber (var n: extended;
                                var err: boolean);
    var
        str: string;
        x: extended;
        minStr, maxStr: string;
    begin
        GetContents(str);
        GetNum(str, x, err);
        if not err then begin
                if (x < minVal) | (x > maxVal) then
                    err := true
                else
                    n := x;
            end;
        if err & displayAlertOnError then begin
                RealToString(minVal, minStr);
                RealToString(maxVal, maxStr);
                if (minVal > -1e1000) & (maxVal < 1e1000) then
                    str := StringOf('You must type in a legal real number in the range between ', minStr, ' and ', maxStr, '.')
                else if (minVal > -1e1000) then
                    str := Concat('You must type in a legal real number, greater than ', minStr)
                else if (maxVal < 1e1000) then
                    str := Concat('You must type in a legal real number, less than ', maxStr)
                else
                    str := 'You must type in a legal real number.';
                TellUser(str);
                select;
                TESetSelect(0, 32000, TE);
            end;
    end;

procedure xRealInput.SetContentsToNumber (n: extended);
    var
        str: string;
    begin
        RealToString(n, str);
        SetContents(str);
    end;

procedure xRealInput.SetUp (win: xWindow;
                                theLeft, theTop, theWidth, theHeight: integer);
    begin
        inherited setUp(win, theLeft, theTop, theWidth, theHeight);
        TEAutoView(false, TE);
        TE^^.crOnly := -1;  { no auto word wrap }
        minVal := -1e1000;
        maxVal := 1e1000;
        displayAlertOnError := true;
        SetMaxLength(50);
    end;

procedure xRealInput.doKey (ch: char;
                                modifiers: longint);
    begin
        if not wantsKey then
            EXIT(doKey);
        if ch in ['0'..'9', '+', '-', 'e', 'E', '.', chr(8), chr(9), chr($1C)..chr($1F)] then
            inherited doKey(ch, modifiers)
        else
            Sysbeep(5);
    end;

end.